perm filename PCHK[S1,ALS]1 blob
sn#425530 filedate 1979-03-13 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 UCHKL :
C00013 ENDMK
Cā;
UCHKL :
with STK[TOP] do
begin
if not ((DTYPE in [TYPA,TYPB,TYPC,TYPN])
or IS_INTEGER[DTYPE]) then
ERROR(WCHECKING_INVALID_TYPE);
if DTYPE = TYPN then
if I1 < 0 then (*nil OK*)
else ERROR(WCHECKED_CONSTANT_OUT_OF_RANGE)
else if IS_CONSTANT(TOP) then
begin
if (ADDRORVAL.FPA.MEMADR.DSPLMT < I1) then
ERROR(WCHECKED_CONSTANT_OUT_OF_RANGE)
end
else
begin (*not constant*)
GET_OPERAND(OPND2,TOP);
if TYP = TYPA then
begin (*Make sure address is on heap (or maybe nil)*)
if DTYPE <> TYPA then
ERROR(WADDRESS_CHECK_ON_NONADDRESS);
"Comment out... (*BNDTRPKLU*)
if I1 < 0 then
begin
SKIPLOC := NEWINSTREC;
IMM_OPERAND(OPND1,NILVAL);
EMITSOP(XSKP_EQL_S,0,OPND1,OPND2,nil)
end;
REG_OPERAND(OPNDR,S1RNP);
EMITXOP(XBTRP_B_S,OPNDR,OPND2);
...end of comment out" (*BNDTRPKLU*)
if I1 < 0 then (*BNDTRPKLU*)
begin (*BNDTRPKLU*)
SKIPLOC := NEWINSTREC; (*BNDTRPKLU*)
IMM_OPERAND(OPND1,NILVAL); (*BNDTRPKLU*)
EMITSOP(XSKP_NEQ_S,0,OPND1,OPND2,nil); (*BNDTRPKLU*)
JUMPLOC := NEWINSTREC; (*BNDTRPKLU*)
EMITJOP(XJMPA, 0, UNUSED_OP, ZERO_OP, nil);(*BNDTRPKLU*)
FIXSOP(SKIPLOC,NEWINSTREC) (*BNDTRPKLU*)
end; (*BNDTRPKLU*)
ADDR_OPERAND (OPND1, S1RNPMEMADR); (*BNDTRPKLU*)
SKIP1LOC := NEWINSTREC; (*BNDTRPKLU*)
EMITSOP (XSKP_LSS_S, 0, OPND2, OPND1, nil); (*BNDTRPKLU*)
ADDR_OPERAND (OPND1, S1RNPMEMADR+WORDUNITS); (*BNDTRPKLU*)
SKIP2LOC := NEWINSTREC; (*BNDTRPKLU*)
EMITSOP (XSKP_LEQ_S, 0, OPND2, OPND1, nil); (*BNDTRPKLU*)
FIXSOP (SKIP1LOC, NEWINSTREC); (*BNDTRPKLU*)
EMITJOP (XHALT, 0, UNUSED_OP, ZERO_OP, (*BNDTRPKLU*)
NEWINSTREC); (*BNDTRPKLU*)
FIXSOP (SKIP2LOC, NEWINSTREC); (*BNDTRPKLU*)
if I1 < 0 then (*BNDTRPKLU*)
FIXJOP(JUMPLOC,NEWINSTREC) (*BNDTRPKLU*)
end (*TYPA*)
else
begin (*not address check*)
" The following commented-out section has not been converted to UCODE "
"Comment out... (*BNDTRPKLU*)
if (TYP=TYPJ) and ((I1=0) or (I1=1)) then
begin
(*The error trap handler will deduce that the CHK
was TYPJ by the fact that the BTRP_N was used.*)
S1OP := BTRP_N_X[I1,DTYPE];
IMM_OPERAND(OPND1,I2)
end
else
begin
S1OP := BTRP_B_X[DTYPE];
EXTENDED_REGDISP_OPERAND(OPND1,S1RPC,0);
UPD_BOUNDTBL(OPND1.XW.DISP,I1,I2,TYP);
OPND1.FIXUP := BOUNDFIX
end;
EMITXOP(S1OP,OPND1,OPND2)
...end of comment out" (*BNDTRPKLU*)
IMM_OPERAND (OPND1, I1); (*BNDTRPKLU*)
SKIP1LOC := NEWINSTREC; (*BNDTRPKLU*)
EMITSOP (COMPARE_OP[S1SIZE[DTYPE],ULES], (*BNDTRPKLU*)
0, OPND2, OPND1, nil); (*BNDTRPKLU*)
IMM_OPERAND (OPND1, I2); (*BNDTRPKLU*)
SKIP2LOC := NEWINSTREC; (*BNDTRPKLU*)
EMITSOP (COMPARE_OP[S1SIZE[DTYPE],PLEQ], (*BNDTRPKLU*)
0, OPND2, OPND1, nil); (*BNDTRPKLU*)
FIXSOP (SKIP1LOC, NEWINSTREC); (*BNDTRPKLU*)
EMITJOP (XHALT, 0, UNUSED_OP, ZERO_OP, (*BNDTRPKLU*)
NEWINSTREC); (*BNDTRPKLU*)
FIXSOP (SKIP2LOC, NEWINSTREC); (*BNDTRPKLU*)
end (*not address check*)
end (*not constant*)
end (*PCHK*);
UCHKU :
with STK[TOP] do
begin
if not ((DTYPE in [TYPA,TYPB,TYPC,TYPN])
or IS_INTEGER[DTYPE]) then
ERROR(WCHECKING_INVALID_TYPE);
if DTYPE = TYPN then
if I1 < 0 then (*nil OK*)
else ERROR(WCHECKED_CONSTANT_OUT_OF_RANGE)
else if IS_CONSTANT(TOP) then
begin
if (ADDRORVAL.FPA.MEMADR.DSPLMT < I1)
or (ADDRORVAL.FPA.MEMADR.DSPLMT > I2) then
ERROR(WCHECKED_CONSTANT_OUT_OF_RANGE)
end
else
begin (*not constant*)
GET_OPERAND(OPND2,TOP);
if TYP = TYPA then
begin (*Make sure address is on heap (or maybe nil)*)
if DTYPE <> TYPA then
ERROR(WADDRESS_CHECK_ON_NONADDRESS);
"Comment out... (*BNDTRPKLU*)
if I1 < 0 then
begin
SKIPLOC := NEWINSTREC;
IMM_OPERAND(OPND1,NILVAL);
EMITSOP(XSKP_EQL_S,0,OPND1,OPND2,nil)
end;
REG_OPERAND(OPNDR,S1RNP);
EMITXOP(XBTRP_B_S,OPNDR,OPND2);
if I1 < 0 then
FIXSOP(SKIPLOC,NEWINSTREC)
...end of comment out" (*BNDTRPKLU*)
if I1 < 0 then (*BNDTRPKLU*)
begin (*BNDTRPKLU*)
SKIPLOC := NEWINSTREC; (*BNDTRPKLU*)
IMM_OPERAND(OPND1,NILVAL); (*BNDTRPKLU*)
EMITSOP(XSKP_NEQ_S,0,OPND1,OPND2,nil); (*BNDTRPKLU*)
JUMPLOC := NEWINSTREC; (*BNDTRPKLU*)
EMITJOP(XJMPA, 0, UNUSED_OP, ZERO_OP, nil);(*BNDTRPKLU*)
FIXSOP(SKIPLOC,NEWINSTREC) (*BNDTRPKLU*)
end; (*BNDTRPKLU*)
ADDR_OPERAND (OPND1, S1RNPMEMADR); (*BNDTRPKLU*)
SKIP1LOC := NEWINSTREC; (*BNDTRPKLU*)
EMITSOP (XSKP_LSS_S, 0, OPND2, OPND1, nil); (*BNDTRPKLU*)
ADDR_OPERAND (OPND1, S1RNPMEMADR+WORDUNITS); (*BNDTRPKLU*)
SKIP2LOC := NEWINSTREC; (*BNDTRPKLU*)
EMITSOP (XSKP_LEQ_S, 0, OPND2, OPND1, nil); (*BNDTRPKLU*)
FIXSOP (SKIP1LOC, NEWINSTREC); (*BNDTRPKLU*)
EMITJOP (XHALT, 0, UNUSED_OP, ZERO_OP, (*BNDTRPKLU*)
NEWINSTREC); (*BNDTRPKLU*)
FIXSOP (SKIP2LOC, NEWINSTREC); (*BNDTRPKLU*)
if I1 < 0 then (*BNDTRPKLU*)
FIXJOP(JUMPLOC,NEWINSTREC) (*BNDTRPKLU*)
end (*TYPA*)
else
begin (*not address check*)
"Comment out... (*BNDTRPKLU*)
if (TYP=TYPJ) and ((I1=0) or (I1=1)) then
begin
(*The error trap handler will deduce that the CHK
was TYPJ by the fact that the BTRP_N was used.*)
S1OP := BTRP_N_X[I1,DTYPE];
IMM_OPERAND(OPND1,I2)
end
else
begin
S1OP := BTRP_B_X[DTYPE];
EXTENDED_REGDISP_OPERAND(OPND1,S1RPC,0);
UPD_BOUNDTBL(OPND1.XW.DISP,I1,I2,TYP);
OPND1.FIXUP := BOUNDFIX
end;
EMITXOP(S1OP,OPND1,OPND2)
...end of comment out" (*BNDTRPKLU*)
IMM_OPERAND (OPND1, I1); (*BNDTRPKLU*)
SKIP1LOC := NEWINSTREC; (*BNDTRPKLU*)
EMITSOP (COMPARE_OP[S1SIZE[DTYPE],PLES], (*BNDTRPKLU*)
0, OPND2, OPND1, nil); (*BNDTRPKLU*)
IMM_OPERAND (OPND1, I2); (*BNDTRPKLU*)
SKIP2LOC := NEWINSTREC; (*BNDTRPKLU*)
EMITSOP (COMPARE_OP[S1SIZE[DTYPE],PLEQ], (*BNDTRPKLU*)
0, OPND2, OPND1, nil); (*BNDTRPKLU*)
FIXSOP (SKIP1LOC, NEWINSTREC); (*BNDTRPKLU*)
EMITJOP (XHALT, 0, UNUSED_OP, ZERO_OP, (*BNDTRPKLU*)
NEWINSTREC); (*BNDTRPKLU*)
FIXSOP (SKIP2LOC, NEWINSTREC); (*BNDTRPKLU*)
end (*not address check*)
end (*not constant*)
end (*PCHK*);